perm filename REVAL3.LBK[F75,JMC] blob
sn#191109 filedate 1975-12-10 generic text, type T, neo UTF8
00100
00200
00300 (DEFPROP ALLFNS
00400 (NIL OEV REV1 REV COUNT SUBB ELEM OEVAL REVAL1 REVAL PRUP X1 X2 X3 X4 X5)
00500 VALUE)
00600
00700 (DEFPROP OEV
00800 (LAMBDA (U V) ((LAMBDA (M) (CONS (REVAL U V) COUNT)) (SETQ COUNT 0)))
00900 EXPR)
01000
01100 (DEFPROP REV1
01200 (LAMBDA (U V) ((LAMBDA (M) (CONS (REVAL1 U V) COUNT)) (SETQ COUNT 0)))
01300 EXPR)
01400
01500 (DEFPROP REV
01600 (LAMBDA (U V) ((LAMBDA (M) (CONS (REVAL U V) COUNT)) (SETQ COUNT 0)))
01700 EXPR)
01800
01900 (DEFPROP COUNT
02000 (NIL . 4)
02100 VALUE)
02200
02300 (DEFPROP SUBB
02400 (LAMBDA (X Y Z) (IF (ATOM Z) (IF (EQ Y Z) X Z) (CONS (SUBB X Y (CAR Z)) (SUBB X Y (CDR Z)))))
02500 EXPR)
02600
02700 (DEFPROP ELEM
02800 (NIL ATOM EQ EQUAL CAR CDR CONS NULL LIST CADR CAAR CDAR CDDR)
02900 VALUE)
03000
03100 (DEFPROP OEVAL
03200 (LAMBDA(E A)
03300 ((LAMBDA(V)
03400 (COND ((ATOM E) (CDR (ASSOC E A)))
03500 ((EQ (CAR E) (QUOTE QUOTE)) (CADR E))
03600 ((EQ (CAR E) (QUOTE IF)) (COND ((OEVAL (CADR E) A) (OEVAL (CADDR E) A)) (T (OEVAL (CADDDR E) A))))
03700 ((MEMBER (CAR E) ELEM)
03800 (EVAL
03900 (CONS (CAR E)
04000 (MAPCAR (FUNCTION (LAMBDA (W) (LIST (QUOTE QUOTE) (OEVAL W A))))(CDR E)))))
04100 (T
04200 ((LAMBDA (Z) (OEVAL (CADDR Z) (APPEND (PRUP (CADR Z)
04300 (MAPCAR (FUNCTION (LAMBDA (W) (OEVAL W A))) (CDR E))) A)))
04400 (GET (CAR E) (QUOTE EXPR))))
04500 ))
04600 (SETQ COUNT (ADD1 COUNT))))
04700 EXPR)
04800
04900 (DEFPROP REVAL1
05000 (LAMBDA(E A)
05100 ((LAMBDA(V)
05200 (COND ((ATOM E) ((LAMBDA (W) (REVAL1 (CAR W) (CADR W))) (CDR (ASSOC E A))))
05300 ((EQ (CAR E) (QUOTE QUOTE)) (CADR E))
05400 ((EQ (CAR E) (QUOTE IF)) (COND ((REVAL1 (CADR E) A) (REVAL1 (CADDR E) A)) (T (REVAL1 (CADDDR E) A))))
05500 ((MEMBER (CAR E) ELEM)
05600 (EVAL (CONS (CAR E) (MAPCAR (FUNCTION (LAMBDA (W) (LIST (QUOTE QUOTE) (REVAL1 W A)))) (CDR E)))))
05700 (T
05800 ((LAMBDA(W)
05900 (REVAL1 (CADDR W) (APPEND (PRUP (CADR W) (MAPCAR (FUNCTION (LAMBDA (Z) (LIST Z A))) (CDR E))) A)))
06000 (GET (CAR E) (QUOTE EXPR))))))
06100 (SETQ COUNT (ADD1 COUNT))))
06200 EXPR)
06300
06400 (DEFPROP REVAL
06500 (LAMBDA(E A)
06600 ((LAMBDA(V)
06700 (COND ((ATOM E)
06800 ((LAMBDA(W)
06900 ((LAMBDA (Z) ((LAMBDA (U) Z) (RPLACD W (LIST (LIST (QUOTE QUOTE) Z) NIL))))
07000 (REVAL (CADR W) (CADDR W))))
07100 (ASSOC E A)))
07200 ((EQ (CAR E) (QUOTE QUOTE)) (CADR E))
07300 ((EQ (CAR E) (QUOTE IF)) (COND ((REVAL (CADR E) A) (REVAL (CADDR E) A)) (T (REVAL (CADDDR E) A))))
07400 ((MEMBER (CAR E) ELEM)
07500 (EVAL (CONS (CAR E) (MAPCAR (FUNCTION (LAMBDA (W) (LIST (QUOTE QUOTE) (REVAL W A)))) (CDR E)))))
07600 (T
07700 ((LAMBDA(W)
07800 (REVAL (CADDR W) (APPEND (PRUP (CADR W) (MAPCAR (FUNCTION (LAMBDA (Z) (LIST Z A))) (CDR E))) A)))
07900 (GET (CAR E) (QUOTE EXPR))))))
08000 (SETQ COUNT (ADD1 COUNT))))
08100 EXPR)
08200
08300 (DEFPROP PRUP
08400 (LAMBDA (U V) (COND ((NULL U) NIL) (T (CONS (CONS (CAR U) (CAR V)) (PRUP (CDR U) (CDR V))))))
08500 EXPR)
08600
08700 (DEFPROP X1
08800 (NIL (U (QUOTE (A B)) NIL) (V (QUOTE C) NIL) (W (QUOTE (C . C)) NIL))
08900 VALUE)
09000
09100 (DEFPROP X2
09200 (NIL (U A B) (V . C) (W C . C))
09300 VALUE)